Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Libraries/MCC Utils/MCStrings.p

Text File | 1994-05-04 | 13.9 KB | 464 lines | [TEXT/PJMM]

{This document is formated in monaco 9 pt                                          }
{                                                                                  }
{LEGAL STUFF                                                                       }
{                                                                                  }
{Copyright © 1994 by University of Melbourne. All Rights Reserved. This work is    }
{provided "as is" and without any express or implied warranties, including,        }
{without limitation, the implied warranties of merchantability and fitness         }
{for a particular purpose.                                                         }
{                                                                                  }
{University of Melbourne is not responsible for the consequences of the use of this}
{work, regardless of the cause. You may use this work in a public domain,          }
{freeware, or shareware product with no restrictions, as long as you include       }
{the following notice in your product's about box or splash screen:                }
{  "Portions Copyright © 1994 by University of Melbourne".                         }
{If you use more than 50 lines of this work, please credit the author also:        }
{  "Portions by Michael Cutter"                                                    }
{Public domain is defined as something that you release to the public, without     }
{copyright and without restrictions on use. Freeware is a copyrighted work,        }
{for which you charge no money. Shareware is a copyrighted work for which you      }
{charge a fee if the user decides to keep it. If you intend to use this work       }
{in a commercial product, please contact us.                                       }
{                                                                                  }
{                                                                                  }
{OTHER STUFF                                                                       }
{                                                                                  }
{AUTHOR:                                                                           }
{ Michael Trevor Cutter                                                            }
{                                                                                  }
{CONTACT:                                                                          }
{  Internet:                                                                       }
{    [e-mail] (Preferred)                                          }
{  Snail Mail:                                                                     }
{    Dept of Architecture & Building                                               }
{    University of Melbourne                                                       }
{    Parkville VIC 3052                                                            }
{    AUSTRALIA                                                                     }
{                                                                                  }
{PERSONAL STUFF                                                                    }
{  I'd really appreciate it if you'd let me know what you're using my code         }
{  in, (send me email or a postcard). Please report any bugs or errors to me.      }
{                                                                                  }
{MODULE DESCRIPTION                                                                }
{This modules includes a variety of functions for manipulating string resources,   }
{include settings STR# resources.                                                  }

unit MCStrings;
interface
    uses
        MCHandlesAndStrs;
    type
        MCParamStrArray = array[0..9] of Str255;

{This is just my own ParamStr function. Handles ^0..^9, rather than just ^0..^3 like the dialog}
{manager one does.}
    procedure MCParamStr (var deststr: Str255;
                                    strs: MCParamStrArray);

{given outstr, insert instr into outstr where the ^0 is. Doesn't handle multiple occurrences of ^0}
    procedure MCInsertString (instr: str255;
                                    var outstr: str255);

{My interface to GetString, cause I like it better this way}
{not very stack friendly, tho}
    function MCGetString (resid: integer): str255;

{Loads the STR resource called strname}
    function MCGetNamedString (strname: Str255): str255;

{Get the STR resource with id resid, and insert instr at the first occurrence of ^0 in it}
    function MCGetInsertionString (resid: integer;
                                    instr: str255): str255;

{Get the STR# resource with id resid, and the index'th string in it}
    function MCGetIndString (resid: integer;
                                    index: integer): str255;

{Count the number of strings in a STR# resource resid}
    function MCCountIndStrings (resid: integer;
                                    var numofstrs: integer): OSErr;

{Get the STR# resource with id resid, and the index'th string in it}
{and insert instr at the first occurrence of ^0}
    function MCGetIndInsertionString (resid: integer;
                                    index: integer;
                                    instr: str255): str255;

{VERY simple encryption function (it actually just does a rot-13. Do NOT use}
{except where you don't REALLY mind it being hacked}
    function MCEncryptString (str: str255): str255;
    function MCUnencryptString (str: str255): str255;
    function MCGetEncryptedString (resid: integer): str255;

{Set the STR resource to newstr}
    function MCSetString (resid: integer;
                                    newstr: str255): OSErr;
{Set the index'th string of the STR# resource to newstr}
    function MCSetIndString (resid: integer;
                                    index: integer;
                                    newstr: str255): OSErr;
implementation

    procedure MCParamStr (var deststr: Str255;
                                    strs: MCParamStrArray);
{allows you to insert up to 10 parameters into a string, rather than the limit of four which ParamStr gives you}
        var
            i, off: integer;
            numstr: Str255;
    begin
        i := 0;
        while (strs[i] <> '') and (i <= 9) do
            begin
                numstr := '';
                NumToString(i, numstr);
                numstr := concat('^', numstr);
                off := 0;
                off := pos(numstr, deststr);
                if off <> 0 then
                    begin
                        delete(deststr, off, 2);
                        insert(strs[i], deststr, off);
                    end;
                i := i + 1;
            end;
    end;

    procedure MCInsertString (instr: str255;
                                    var outstr: str255);
{searches given string for ^0, and replaces it with instr}
        var
            off: integer;
    begin
        off := pos('^0', outstr);
        if off <> 0 then
            begin
                delete(outstr, off, 2);
                insert(instr, outstr, off);
            end;
    end;

    function MCGetString;
        var
            strh: StringHandle;
    begin
        strh := nil;
        strh := StringHandle(NewHandle(0));
        strh := GetString(resid);
        if (strh <> nil) and (GetHandleSize(Handle(strh)) > 0) then
            begin
                hlock(handle(strh));
                MCGetString := strh^^;
                hunlock(handle(strh));
                ReleaseResource(handle(strh));
            end
        else
            MCGetString := '';
    end;

    function MCGetNamedString;
        var
            strh: StringHandle;
    begin
        strh := nil;
        strh := StringHandle(Get1NamedResource('STR ', strname));
        if (strh <> nil) and (GetHandleSize(Handle(strh)) > 0) then
            begin
                hlock(handle(strh));
                MCGetNamedString := strh^^;
                hunlock(handle(strh));
                ReleaseResource(handle(strh));
            end
        else
            MCGetNamedString := '';
    end;

    function MCGetInsertionString;
        var
            str: str255;
            strh: StringHandle;
    begin
        strh := StringHandle(NewHandle(0));
        strh := GetString(resid);
        if (strh <> nil) and (GetHandleSize(Handle(strh)) > 0) then
            begin
                DetachResource(handle(strh));
                hlock(handle(strh));
                str := strh^^;
                MCInsertString(instr, str);
                MCGetInsertionString := str;
                hunlock(handle(strh));
                ReleaseResource(handle(strh));
            end
        else
            MCGetInsertionString := '';
    end;

    function MCGetIndString;
    begin
        GetIndString(MCGetIndString, resid, index);
    end;

    function MCCountIndStrings;
        var
            resh: Handle;
            myErr: OSErr;
    begin
        MCCountIndStrings := noErr;
        resh := nil;
        resh := Get1Resource('STR#', resid);
        if resh <> nil then
            begin
                hlock(resh);
                BlockMove(resh^, @numofstrs, 2);
                hunlock(resh);
                ReleaseResource(resh);
            end
        else
            begin
                MCCountIndStrings := ResError;
            end;
    end;

    function MCGetIndInsertionString;
        var
            str: str255;
    begin
        GetIndString(str, resid, index);
        MCInsertString(instr, str);
        MCGetIndInsertionString := str;
    end;


    function MCEncryptString (str: str255): str255;
{ASK MIKE!!!! Are ~'s allowed in Passwords?}
        var
            pos, i, len: integer;
            c, e: char;
            kspace, ktilde: integer; {start and end of printable ascii}
    begin
{init}
        kspace := ord(' ');
        ktilde := ord('~');

        len := length(str);
        for i := 1 to len do
            begin
                c := str[i];
                pos := ord(c) + 13;
                if pos > ktilde then
                    str[i] := chr(pos - ktilde + kspace) {over end of 'alphabet'}
                else
                    str[i] := chr(pos);    {not over end of 'alphabet'}
            end;
        MCEncryptString := str;
    end;

    function MCUnencryptString (str: str255): str255;
        var
            pos, i, len: integer;
            c, e: char;
            kspace, ktilde: integer; {start and end of printable ascii}
    begin
{init}
        kspace := ord(' ');
        ktilde := ord('~');

        len := length(str);
        for i := 1 to len do
            begin
                c := str[i];
                pos := ord(c) - 13;
                if pos < kspace then
                    str[i] := chr(ktilde - (kspace - pos)) {over start of 'alphabet'}
                else
                    str[i] := chr(pos);    {not over start of 'alphabet'}
            end;
        MCUnencryptString := str;
    end;

    function MCGetEncryptedString;
{This function currently decodes a simple Rot-13 encryption method}
        var
            encstr: str255;
            strh: StringHandle;
    begin
        strh := StringHandle(NewHandle(0));
        strh := GetString(resid);
        if strh <> nil then
            begin
                DetachResource(handle(strh));
                hlock(handle(strh));
                encstr := strh^^;
                hunlock(handle(strh));
                ReleaseResource(handle(strh));
                encstr := MCUnencryptString(encstr);
            end
        else
            encstr := '';
        MCGetEncryptedString := encstr;
    end;

    function MCSetString (resid: integer;
                                    newstr: str255): OSErr;
        var
            tmpstrh: StringHandle;
    begin
        MCSetString := noErr;
        tmpstrh := nil;
        tmpstrh := StringHandle(Get1Resource('STR ', resid));
        if ResError <> noErr then
            begin
                MCSetString := ResError;
                exit(MCSetString);
            end;
        SetString(tmpstrh, newstr);
        ChangedResource(handle(tmpstrh));
        if ResError <> noErr then
            begin
                MCSetString := ResError;
                exit(MCSetString);
            end;
        WriteResource(handle(tmpstrh));
        if ResError <> noErr then
            begin
                MCSetString := ResError;
                exit(MCSetString);
            end;
        ReleaseResource(handle(tmpstrh));
    end;

    function MCSetIndString (resid: integer;
                                    index: integer;
                                    newstr: str255): OSErr;
{how this works: }
{Load resource into memory}
{get the number of strs in the resource}
{index your way to the start of the requested str}
{remember that position, then move along to start of next str}
{copy remainder of the handle into new handle}
{delete everything in the original handle past the start of the desired str}
{append the new str onto the original handle}
{append the remaining handle on to the handle}
{dispose any handles}
{save the resource}
{exit}

        var
            resh, remh, beginh: Handle;
            numofstrs: integer;
            strstart, nextstrstart: longint;

            curpos, reshandlesize: longint;
            curstr, strlen: integer;

        procedure CatchOSErr (err: OSErr);
        begin
            if err <> noErr then
                begin
                    MCSetIndString := err;
                    exit(MCSetIndString)
                end;
        end;
    begin
        MCSetIndString := noErr;

{Load resource into memory}
        resh := nil;
        resh := Get1Resource('STR#', resid);
        CatchOSErr(ResError);
        reshandlesize := GetHandleSize(resh);
        Hlock(resh);

{get the number of strs in the resource}
        BlockMove(resh^, @numofstrs, 2);
        CatchOSErr(MemError);

{index your way to the start of the requested str}
    {get length of first string}
        curpos := 2;
        curstr := 1;
        if index = 2 then
            begin
                strlen := 0;
                BlockMove(pointer(ord4(resh^) + curpos), pointer(ord4(@strlen) + 1), 1);
                CatchOSErr(MemError);
                curpos := curpos + strlen + 1; {the 1 is for the length byte}
            end
        else if index > 2 then
            begin
                repeat
                    strlen := 0;
                    BlockMove(pointer(ord4(resh^) + curpos), pointer(ord4(@strlen) + 1), 1);
                    CatchOSErr(MemError);
                    curpos := curpos + strlen + 1; {the 1 is for the length byte}
                    curstr := curstr + 1;
                until (curpos > reshandlesize) or (curstr = index);
                if curpos > reshandlesize then
                    CatchOSErr(10000 + index);
            end;
        strstart := curpos;

{remember that position, then move along to start of next str}
        strlen := 0;
        BlockMove(pointer(ord4(resh^) + curpos), pointer(ord4(@strlen) + 1), 1);
        CatchOSErr(MemError);

        curpos := curpos + strlen + 1;
        nextstrstart := curpos;

{copy remainder of the handle into new handle}
        remh := nil;
        remh := NewHandle(reshandlesize - nextstrstart);
        hlock(remh);
        BlockMove(pointer(ord4(resh^) + nextstrstart), remh^, reshandlesize - nextstrstart);
        CatchOSErr(MemError);
        hunlock(remh);

{delete everything in the original handle past the start of the desired str}
    {copy up to start of string}
        beginh := nil;
        beginh := NewHandle(strstart);
        hlock(beginh);
        BlockMove(resh^, beginh^, strstart);
        CatchOSErr(MemError);

        hunlock(beginh);

{append the new str onto the original handle}
        reshandlesize := GetHandleSize(beginh);
        strlen := length(newstr);

{append length byte}
        BlockMove(pointer(ord4(@strlen) + 1), pointer(ord4(beginh^) + reshandlesize), 1);
        CatchOSErr(MemError);
        SetHandleSize(beginh, reshandlesize + 1);
        CatchOSErr(MCAppendStrToHndl(newstr, beginh));

{append the remaining handle on to the handle}
        CatchOSErr(MCAppendHndlToHndl(remh, beginh));

{copy the new handle back to resh}
        reshandlesize := GetHandleSize(beginh);
        hlock(beginh);
        hunlock(resh);
        SetHandleSize(resh, reshandlesize);
        hlock(resh);
        BlockMove(beginh^, resh^, reshandlesize);
        CatchOSErr(MemError);
        hunlock(resh);
        hunlock(beginh);

{dispose all internally allocated handles}
        DisposeHandle(beginh);
        DisposeHandle(remh);

{save the resource}
        ChangedResource(resh);
        CatchOSErr(ResError);

        WriteResource(resh);
        CatchOSErr(ResError);
        ReleaseResource(resh);
    end;

end.